unit fSilhouette;

interface

uses
  Winapi.Windows,
  Winapi.Messages,
  Winapi.MMSystem,
  System.SysUtils,
  System.Variants,
  System.Classes,
  Vcl.StdCtrls,
  Vcl.Graphics,
  Vcl.Controls,
  Vcl.Forms,
  Vcl.Dialogs,
  GLS.Scene,
  GLS.Objects,
  GLS.Cadencer,
  GLS.SceneViewer,
  GLS.VectorFileObjects,
  GLS.VectorLists,
  GLS.VectorTypes,
  GLS.VectorGeometry,
  GLS.Coordinates,

  GLS.PersistentClasses,
  GLS.BaseClasses,
  GLS.FileMS3D;

const
  cCOUNT = 500;

type
  TForm1 = class(TForm)
    GLScene1: TGLScene;
    GLSceneViewer1: TGLSceneViewer;
    GLCamera1: TGLCamera;
    GLCadencer1: TGLCadencer;
    GLDummyCube1: TGLDummyCube;
    GLLightSource1: TGLLightSource;
    GLFreeForm1: TGLFreeForm;
    Memo1: TMemo;
    CheckBox_MeshVisible: TCheckBox;
    GLLines1: TGLLines;
    GLDummyCube2: TGLDummyCube;
    Button_Silhouette: TButton;
    CheckBox_ShowSilhouette: TCheckBox;
    Button_MultiRun: TButton;
    Button_Preprocessed: TButton;
    procedure FormCreate(Sender: TObject);
    procedure GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure CheckBox_MeshVisibleClick(Sender: TObject);
    procedure Button_SilhouetteClick(Sender: TObject);
    procedure Button_MultiRunClick(Sender: TObject);
    procedure Button_PreprocessedClick(Sender: TObject);
  private
    function GetTime: double;
  public
    FPerformanceFreq: Int64;
    FPerformanceStart: Int64;
    procedure CalculateSilhouette(ShowTime: boolean = true);
  end;

  TSortingIntegerList = class(TGLIntegerList)
  public
    // Locate a value in a sorted list.
    function BinarySearch(const Value: Integer): Integer; overload;
    function BinarySearch(const Value: Integer; ReturnBestFit: boolean; var Found: boolean)
      : Integer; overload;
    // Add integer to a sorted list.
    function AddSorted(const Value: Integer; const IgnoreDuplicates: boolean = false): Integer;
  end;

var
  Form1: TForm1;

implementation

uses
  uSilhouette;

{$R *.dfm}

procedure AddMessage(s: string);
begin
  Form1.Memo1.Lines.Add(s);
end;

function TForm1.GetTime: double;
var
  Stop: Int64;
begin
  if (FPerformanceFreq = 0) then
    result := timeGetTime
  else
  begin
    QueryPerformanceCounter(Stop);
    result := Stop / FPerformanceFreq * 1000;
  end; // }
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  // Get frequency
  QueryPerformanceFrequency(FPerformanceFreq);
  // Get initial count
  QueryPerformanceCounter(FPerformanceStart);
  // GLFreeForm1.LoadFromFile('box.ms3d');
  // GLFreeForm1.LoadFromFile('BigHoleBox.ms3d');
  // GLFreeForm1.LoadFromFile('face.ms3d');

  GLFreeForm1.LoadFromFile('LScene.ms3d');
  GLDummyCube1.Scale.X := 0.25;
  GLDummyCube1.Scale.Y := 0.25;
  GLDummyCube1.Scale.Z := 0.25; // }

  { GLFreeForm1.LoadFromFile('Scene.ms3d');
    GLDummyCube1.Scale.X := 0.25;
    GLDummyCube1.Scale.Y := 0.25;
    GLDummyCube1.Scale.Z := 0.25;// }

  { GLFreeForm1.LoadFromFile('HighPolyObject.3ds');
    GLDummyCube1.Scale.X := 0.1;
    GLDummyCube1.Scale.Y := 0.1;
    GLDummyCube1.Scale.Z := 0.1;// }

  { GLFreeForm1.LoadFromFile('TRINITYrage.smd');
    GLDummyCube1.Scale.X := 0.1;
    GLDummyCube1.Scale.Y := 0.1;
    GLDummyCube1.Scale.Z := 0.1;// }

  { GLFreeForm1.LoadFromFile('teapot.3ds');
    GLDummyCube1.Scale.X := 0.1;
    GLDummyCube1.Scale.Y := 0.1;
    GLDummyCube1.Scale.Z := 0.1;// }

  // Note how the result for "FreakShip.ms3d" looks terrible - this is because
  // the mesh is broken! (there are holes in it)
  // GLFreeForm1.LoadFromFile('FreakShip.ms3d');

  CalculateSilhouette(false);
end;

procedure TForm1.CalculateSilhouette(ShowTime: boolean = true);
var
  LiveEdges: Integer;

  procedure TryAddEdge(EdgeList: TSortingIntegerList; Vi0, Vi1: word);
  var
    Key: Integer;
    Pos: Integer;
  begin
    if Vi0 < Vi1 then
      Key := Vi0 shl 1 + Vi1 shl 16
    else
      Key := Vi1 shl 1 + Vi0 shl 16;

    Pos := EdgeList.BinarySearch(Key);
    if Pos <> -1 then
    begin
      EdgeList[Pos] := EdgeList[Pos] or 1;
      dec(LiveEdges);
    end
    else
    begin
      EdgeList.AddSorted(Key); // }
      inc(LiveEdges);
    end;
  end;

var
  iFace, iFaceGroup, iMeshObject, iEdge: Integer;
  FaceGroup: TFGVertexIndexList;
  SeenFrom, FaceNormal, LightNormal: TAffineVector;
  Vi0, Vi1, Vi2: Integer;
  V0, V1, V2: TAffineVector;
  MeshObject: TGLMeshObject;
  dot: single;
  EdgeList: TSortingIntegerList;
  w1, w2: word;
  GLLines: TGLLines;
  StartTime: double;
  EdgeKey: Integer;
begin
  if CheckBox_ShowSilhouette.Checked then
  begin
    while GLDummyCube2.Count > 0 do
      GLDummyCube2.Children[0].Free;
  end;

  StartTime := GetTime;
  // SeenFrom := GLCamera1.Position.AsAffineVector;
  SeenFrom.X := GLCamera1.AbsolutePosition.X;
  SeenFrom.Y := GLCamera1.AbsolutePosition.Y;
  SeenFrom.Z := GLCamera1.AbsolutePosition.Z;

  SeenFrom := GLFreeForm1.AbsoluteToLocal(SeenFrom);

  EdgeList := TSortingIntegerList.Create;

  try
    for iMeshObject := 0 to GLFreeForm1.MeshObjects.Count - 1 do
    begin
      MeshObject := GLFreeForm1.MeshObjects[iMeshObject];

      for iFaceGroup := 0 to MeshObject.FaceGroups.Count - 1 do
      begin
        FaceGroup := TFGVertexIndexList(MeshObject.FaceGroups[iFaceGroup]);
        EdgeList.Clear;
        EdgeList.Capacity := FaceGroup.TriangleCount;
        LiveEdges := 0;

        // Create an edge table
        // 1. Loop through all the model's triangles
        for iFace := 0 to FaceGroup.TriangleCount - 1 do
        begin
          // Retrieve the vertex indices
          Vi0 := FaceGroup.VertexIndices[iFace * 3 + 0];
          Vi1 := FaceGroup.VertexIndices[iFace * 3 + 1];
          Vi2 := FaceGroup.VertexIndices[iFace * 3 + 2];

          // Retrieve the actual vertices, in absolute coords
          V0 := MeshObject.Vertices[Vi0];
          V1 := MeshObject.Vertices[Vi1];
          V2 := MeshObject.Vertices[Vi2]; // }
          FaceNormal := CalcPlaneNormal(V0, V1, V2); // }

          LightNormal := VectorSubtract(SeenFrom, V0
            { VectorScale(VectorAdd(VectorAdd(V0, V1), V2), 1/3) } ); // }

          dot := VectorDotProduct(FaceNormal, LightNormal);

          // 2. If triangle faces the light source (dot product > 0)

          if dot >= 0 then
          begin
            // 3. Insert the three edges (pair of vertices), into an edge stack

            // THIS METHOD IS LIMITED TO 65535 TRIANGLES!
            // 4. Check for previous occurrence of each edges or it's reverse in the stack
            // 5. If an edge or its reverse is found in the stack, remove both edges
            TryAddEdge(EdgeList, Vi0, Vi1);
            TryAddEdge(EdgeList, Vi1, Vi2);
            TryAddEdge(EdgeList, Vi2, Vi0);

            // 6. Start with new triangle
          end;
        end;

        // AddMessage(Format('EdgeCount = %d',[EdgeList.Count]));

        // Handle ALL edges for the mesh object
        if CheckBox_ShowSilhouette.Checked then
        begin
          for iEdge := 0 to EdgeList.Count - 1 do
          begin
            EdgeKey := EdgeList[iEdge];
            if ((EdgeKey and 1) = 0) then
            begin
              Vi0 := (EdgeKey shr 16);
              Vi1 := (EdgeKey and 65535) shr 1;

              GLLines := TGLLines(GLDummyCube2.AddNewChild(TGLLines));
              GLLines.ShowAxes := false;
              GLLines.LineWidth := 3;
              GLLines.NodesAspect := lnaInvisible;

              GLLines.Nodes.AddNode(GLFreeForm1.LocalToAbsolute(MeshObject.Vertices[Vi0]));
              GLLines.Nodes.AddNode(GLFreeForm1.LocalToAbsolute(MeshObject.Vertices[Vi1])); // }
            end;
          end;
        end;
      end;

      EdgeList.Clear;
    end;

    if ShowTime then
      AddMessage(Format('Time=%f ms', [GetTime - StartTime]));
  finally
    EdgeList.Free;
  end;

  GLFreeForm1.Position.X := -GLFreeForm1.Position.X;
  GLFreeForm1.Position.Y := -GLFreeForm1.Position.Y;
end;

var
  mx, my: Integer;

procedure TForm1.GLSceneViewer1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if ssLeft in Shift then
    GLCamera1.MoveAroundTarget(my - Y, mx - X);

  mx := X;
  my := Y;
end;

procedure TForm1.CheckBox_MeshVisibleClick(Sender: TObject);
begin
  GLFreeForm1.Visible := CheckBox_MeshVisible.Checked;
end;

procedure TForm1.Button_SilhouetteClick(Sender: TObject);
begin
  CalculateSilhouette;
end;

procedure TForm1.Button_MultiRunClick(Sender: TObject);
var
  i: Integer;
  StartTime: double;
  TotalTime: double;
begin
  CheckBox_ShowSilhouette.Checked := false;

  StartTime := GetTime;
  for i := 0 to cCOUNT - 1 do
    CalculateSilhouette(false);

  TotalTime := GetTime - StartTime;
  AddMessage(Format('%d runs in %f ms => %f ms / run', [cCOUNT, TotalTime, TotalTime / cCOUNT]));

end;

procedure TForm1.Button_PreprocessedClick(Sender: TObject);
var
  CI: TGLConnectivityInformation;
  List: TList;
  i: Integer;
  GLLines: TGLLines;
  SeenFrom: TAffineVector;
  Edge: TGLCIEdge;
  StartTime, TotalTime: double;
begin
  while GLDummyCube2.Count > 0 do
    GLDummyCube2.Children[0].Free;

  SeenFrom.X := GLCamera1.AbsolutePosition.X;
  SeenFrom.Y := GLCamera1.AbsolutePosition.Y;
  SeenFrom.Z := GLCamera1.AbsolutePosition.Z;

  CI := TGLConnectivityInformation.Create(GLFreeForm1.MeshObjects[0]);

  try
    CI.BuildEdgeList;

    List := TList.Create;

    StartTime := GetTime;

    for i := 0 to cCOUNT - 1 do
      CI.CreateSilhouette(SeenFrom, List);

    TotalTime := GetTime - StartTime;
    AddMessage(Format('%d runs = %f ms => %f ms / run', [cCOUNT, TotalTime, TotalTime / cCOUNT]));

    for i := 0 to List.Count - 1 do
    begin
      Edge := TGLCIEdge(List[i]);
      GLLines := TGLLines(GLDummyCube2.AddNewChild(TGLLines));
      GLLines.LineWidth := 3;
      GLLines.NodesAspect := lnaInvisible;

      GLLines.Nodes.AddNode(GLFreeForm1.LocalToAbsolute(GLFreeForm1.MeshObjects[0].Vertices
        [Edge.VertexIndex[0]]));
      GLLines.Nodes.AddNode(GLFreeForm1.LocalToAbsolute(GLFreeForm1.MeshObjects[0].Vertices
        [Edge.VertexIndex[1]])); // }
    end;

    AddMessage(Format('List.Count=%d', [List.Count]));
  finally
    CI.Free;
    FreeAndNil(List);
  end;
end;

// BinarySearch assumes that the list is sorted
//
{ TSortingIntegerList }

function TSortingIntegerList.AddSorted(const Value: Integer;
  const IgnoreDuplicates: boolean = false): Integer;
var
  WantedIndex: Integer;
  Found: boolean;
begin
  WantedIndex := BinarySearch(Value, true, Found);

  if IgnoreDuplicates and Found then
  begin
    result := -1;
    exit;
  end
  else
  begin
    Insert(WantedIndex + 1, Value);
    result := WantedIndex + 1;
  end;
end;

function TSortingIntegerList.BinarySearch(const Value: Integer): Integer;
var
  Found: boolean;
begin
  result := BinarySearch(Value, false, Found);
end;

function TSortingIntegerList.BinarySearch(const Value: Integer; ReturnBestFit: boolean;
  var Found: boolean): Integer;
var
  Index: Integer;
  Min, Max, Mid: Integer;
begin
  // Assume we won't find it
  Found := false;

  // If the list is empty, we won't find the sought value!
  if Count = 0 then
  begin
    result := -1;
    exit;
  end;

  Min := -1; // ONE OFF!
  Max := Count; // ONE OFF!

  // We now know that Min and Max AREN'T the values!

  Index := -1;

  repeat
    // Find the middle of the current scope
    Mid := (Min + Max) div 2;

    // Is this the one?
    if (Items[Mid] = Value) then
    begin
      Index := Mid;
      Found := true;
      break;
    end;

    // Reduce the search scope by half
    if Items[Mid] < Value then
      Min := Mid
    else
      Max := Mid;
  until (Min = Max - 1);

  if ReturnBestFit then
  begin
    if index > -1 then
      result := Index
    else
      result := Min;
  end
  else
  begin
    result := Index;
  end;
end;

end.
